home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 051-075 / disk_075 / dum2 / src / duwindow.mod < prev    next >
Text File  |  1992-05-06  |  14KB  |  405 lines
  1. IMPLEMENTATION MODULE DuWindow;
  2.  
  3. (*$S-*)(*$T-*)(*$A+*)
  4. (*
  5.         PART OF DirUtil for Modula 2
  6.  
  7.         This creates, opens and maintains the DirUtil window.
  8.         It contains a couple of other importable routines for
  9.         user alterations.
  10.  
  11.         Written: 3/21/87 by Greg Browne
  12.  
  13.         Compiles on TDI's Modula-2 Compiler version 2.20a
  14.  
  15.  NOTES: I kept being bugged with RefreshWindow not being exported from
  16.         Intuition as a flag. Then I found that it is either misspelled
  17.         in the .def module (as  ResfreshWindow) or that it is supposed
  18.         to mean ResetFreshWindow. Don't know whats up but it works now.
  19.  
  20. *)
  21.  
  22. FROM SYSTEM             IMPORT  ADR, BYTE, ADDRESS, NULL,TSIZE,CODE;
  23. FROM Intuition          IMPORT  ActivationFlags,ActivationFlagSet,
  24.                                 Gadget,GadgetFlags,GadgetFlagSet,GadgetPtr,
  25.                                 PropFlags,PropInfo,PropFlagSet,StringInfo,
  26.                                 IntuitionTextPtr,IntuitionText,IntuitionName,
  27.                                 IntuitionBase,IntuiMessagePtr,RequesterPtr,
  28.                                 Window,WindowFlags,WindowPtr,NewWindow,
  29.                                 IDCMPFlags,IDCMPFlagSet,WindowFlagSet,
  30.                                 WBenchScreen,Border,SmartRefresh,ScreenFlagSet,
  31.                                 Image;
  32. FROM GraphicsLibrary    IMPORT  GraphicsName, GraphicsBase,DrawingModes,
  33.                                 DrawingModeSet,Jam1;
  34. FROM Libraries          IMPORT  OpenLibrary,CloseLibrary;
  35. FROM Windows            IMPORT  OpenWindow,CloseWindow;
  36. FROM Gadgets            IMPORT  RefreshGadgets,HighNone,HighComplement,
  37.                                 ModifyProp,BoolGadget,PropGadget,StrGadget,
  38.                                 AddGadget,RemoveGadget;
  39.  
  40. (*--------------------------------------------------------------------*)
  41.  
  42. (* ALL CONSTANTS  AND MOST VARIABLES/TYPES DEFINED IN .DEF FILE
  43.    FOR IMPORTATION
  44.  
  45. CONST
  46.   StringBufSize = 255;
  47.   RegFlags      = ActivationFlagSet{RelVerify,GadgetImmediate};
  48.   StringFlags   = ActivationFlagSet{StringCenter} + RegFlags;
  49.   JamTwo        = DrawingModeSet{Jam2};
  50.   SliderFlags   = PropFlagSet{FreeVert,AutoKnob};
  51.  
  52. TYPE
  53.   WBColors      = (Blue,White,Black,Green);     (* My workbench colors *)
  54.  
  55.    Gadgets are addressed as a set. First are the devices, then the message
  56.    string gadgets, then the command gadgets, and finally the slider.  Note
  57.    that this is larger than a BITSET already, so the 'GadgetID' is passed as
  58.    a set name and converted as CARDINAL(ORD(whatever)). Expansion of the set
  59.    should be easy, with only screen positioning being the hard part.
  60.  
  61.   GadgetNames   = (df0,df1,df2,dh0,dh1,ram,vd0,
  62.                    run,source,dest,msg,
  63.                    filewindow,
  64.                    arc,bytes,clear,copy,copydel,deldir,edit,execfr,execrf,
  65.                    hprint,htype,info,makedir,move,parent,print,rename,
  66.                    root,runfr,runrf,select,show,type,unarc,zapfile,
  67.                    dtor,dtos,rtod,rtos,stod,stor,swapsd,swaprd,swaprs,
  68.                    slider);
  69.  
  70.  END OF EXTERNAL TYPES & CONSTANTS  *)
  71.  
  72. TYPE
  73.   BorderTypes   = (filewind,rsd,device,command,message);
  74.  
  75. VAR
  76.   SlideImage    : Image;
  77.   Borders       : ARRAY BorderTypes OF Border;
  78.   SlideInfo     : PropInfo;
  79.  
  80. (* EXTERNAL AVAILABLE VARIABLES
  81.  
  82.   IOStringInfo  : ARRAY[run..filewindow] OF StringInfo;
  83.   NullReqPtr    : RequesterPtr;   (* initialized to be NULL always *)
  84.   DuWindowPtr   : WindowPtr;
  85.   IOString      : ARRAY[run..filewindow] OF ARRAY[0..StringBufSize-1] OF CHAR;
  86.   GadTxt        : ARRAY GadgetNames OF IntuitionText;
  87.   DuGads        : ARRAY GadgetNames OF Gadget;
  88.  
  89. *)
  90. (* ---------------------------*)
  91. (*  INTERNAL ONLY PROCEDURES  *)
  92. (* ---------------------------*)
  93.  
  94. PROCEDURE InitWindow(VAR text:ARRAY OF CHAR;FirstGad:ADDRESS):WindowPtr;
  95. VAR w : NewWindow;
  96. BEGIN
  97.   WITH w DO
  98.     LeftEdge := 0; TopEdge := 0;
  99.     Width := 640; Height := 156;
  100.     DetailPen := BYTE (0); BlockPen := BYTE (1);
  101.     Title := ADR(text);
  102.     Flags := WindowFlagSet{WindowSizing,WindowDepth,WindowDrag,RMBTrap,
  103.                         Activate,NoCareRefresh,WindowClose} + SmartRefresh;
  104.     IDCMPFlags := IDCMPFlagSet{CloseWindowFlag,MouseButtons,
  105.                         ResfreshWindow,GadgetUp};
  106.     Type := ScreenFlagSet {WBenchScreen};
  107.     CheckMark := NULL;
  108.     FirstGadget := FirstGad;
  109.     Screen := NULL; BitMap := NULL;
  110.     MinWidth := 150; MinHeight := 75;
  111.     MaxWidth := 640; MaxHeight := 156;
  112.   END;
  113.   RETURN OpenWindow(w)
  114. END InitWindow;
  115.  
  116. (* ---------------------------*)
  117. (* Entry/exit code off to create "static" border structures with CODE *)
  118. (* This method saves size since I am keeping it under 32767 for $A+   *)
  119. (* ---------------------------*)
  120.  
  121. (*$P-*)
  122.  
  123. PROCEDURE CBorder;
  124. BEGIN
  125.   CODE(0FFFFH,0FFFFH,69,0FFFFH,69,9,0FFFFH,9,0FFFFH,0FFFFH);
  126. END CBorder;
  127.  
  128. (*$P-*)
  129.  
  130. PROCEDURE DBorder;
  131. BEGIN
  132.   CODE(0FFFFH,0FFFFH,39,0FFFFH,39,9,0FFFFH,9,0FFFFH,0FFFFH);
  133. END DBorder;
  134.  
  135. (*$P-*)
  136.  
  137. PROCEDURE MBorder;
  138. BEGIN
  139.   CODE(0FFFEH,0FFFEH,576,0FFFEH,576,8,0FFFEH,8,0FFFEH,0FFFEH);
  140. END MBorder;
  141.  
  142. (*$P-*)
  143.  
  144. PROCEDURE RBorder;
  145. BEGIN
  146.   CODE(0FFFEH,0FFFEH,280,0FFFEH,280,8,0FFFEH,8,0FFFEH,0FFFEH);
  147. END RBorder;
  148.  
  149. (*$P-*)
  150.  
  151. PROCEDURE FBorder;
  152. BEGIN
  153.   CODE(0FFFFH,0FFFFH,283,0FFFFH,283,121,0FFFFH,121,0FFFFH,0FFFFH);
  154. END FBorder;
  155.  
  156. (*$P+*)
  157.  
  158. (* ---------------------------*)
  159.  
  160. PROCEDURE SetIText(VAR it       :IntuitionText;
  161.                    VAR text     :ARRAY OF CHAR;
  162.                    Left,Top     :INTEGER;
  163.                    FColor,BColor:WBColors;
  164.                    Mode         :DrawingModeSet);
  165. BEGIN
  166.   WITH it DO
  167.     FrontPen := BYTE(ORD(FColor));
  168.     BackPen := BYTE(ORD(BColor));
  169.     DrawMode := BYTE(Mode);
  170.     LeftEdge := Left;   TopEdge := Top;
  171.     ITextFont := NULL;  IText := ADR(text);
  172.     NextText := NULL;
  173.   END;
  174. END SetIText;
  175.  
  176. (* ---------------------------*)
  177.  
  178. PROCEDURE OneGadget(VAR gadg:Gadget;                    L,T,W,H:INTEGER;
  179.                         GadFlags:GadgetFlagSet;         textptr:ADDRESS;
  180.                         ActFlags:ActivationFlagSet;     Bdr:ADDRESS;
  181.                         spinfoptr:ADDRESS;              GadType:CARDINAL;
  182.                         GadID:GadgetNames);
  183.   BEGIN
  184.     WITH gadg DO
  185.       NextGadget := NULL;
  186.       LeftEdge := L; TopEdge := T;
  187.       Width := W; Height := H;
  188.       Flags := GadFlags; Activation := ActFlags;
  189.       GadgetType := GadType; GadgetRender := Bdr;
  190.       SelectRender := NULL; GadgetText := textptr;
  191.       MutualExclude := 0; SpecialInfo := spinfoptr;
  192.       GadgetID := CARDINAL(ORD(GadID));
  193.       UserData := NULL;
  194.     END
  195.   END OneGadget;
  196.  
  197. (* ---------------------------*)
  198.  
  199. PROCEDURE InitGadgets():ADDRESS;
  200. (*
  201.    Procedure to initialize all the gadgets and related structures
  202.    internal to the module only
  203. *)
  204.   VAR i,m:GadgetNames; j,k: CARDINAL;
  205.   BEGIN
  206.   WITH Borders[command] DO                      (* Point to the borders  *)
  207.     LeftEdge := 0; TopEdge := 0;                (* And define color/type *)
  208.     FrontPen := BYTE(1); BackPen := BYTE(0);
  209.     DrawMode := BYTE(Jam1); Count := BYTE(5);
  210.     XY := ADDRESS(CBorder); NextBorder := NULL
  211.   END;
  212.   Borders[device] := Borders[command];          (* all same except sizes *)
  213.   Borders[device].XY := ADDRESS(DBorder);
  214.   Borders[message] := Borders[command];
  215.   Borders[message].XY := ADDRESS(MBorder);
  216.   Borders[rsd] := Borders[command];
  217.   Borders[rsd].XY := ADDRESS(RBorder);
  218.   Borders[filewind] := Borders[command];
  219.   Borders[filewind].XY := ADDRESS(FBorder);
  220.  
  221.         (* This section sets up the gadget text and colors/rendering *)
  222.  
  223.   SetIText(GadTxt[df0],     "df0:",    3,1,Black,Blue,Jam1);
  224.   SetIText(GadTxt[df1],     "df1:",    3,1,Black,Blue,Jam1);
  225.   SetIText(GadTxt[df2],     "df2:",    3,1,Black,Blue,Jam1);
  226.   SetIText(GadTxt[dh0],     "dh0:",    3,1,Black,Blue,Jam1);
  227.   SetIText(GadTxt[dh1],     "dh1:",    3,1,Black,Blue,Jam1);
  228.   SetIText(GadTxt[ram],     "ram:",    3,1,Black,Blue,Jam1);
  229.   SetIText(GadTxt[vd0],     "vd0:",    3,1,Black,Blue,Jam1);
  230.   SetIText(GadTxt[run],     "R",     -14,0,Green,Blue,Jam1);
  231.   SetIText(GadTxt[source],  "S",     -14,0,Green,Blue,Jam1);
  232.   SetIText(GadTxt[dest],    "D",     -14,0,Green,Blue,Jam1);
  233.   SetIText(GadTxt[msg],     "M",     -14,0,Green,Blue,Jam1);
  234.   SetIText(GadTxt[filewindow],"",      0,0,Green,Blue,Jam1);
  235.   SetIText(GadTxt[arc],     "ARC",    22,1,White,Blue,Jam1);
  236.   SetIText(GadTxt[bytes],   "BYTES",  14,1,White,Blue,Jam1);
  237.   SetIText(GadTxt[clear],   "CLEAR",  14,1,White,Blue,Jam1);
  238.   SetIText(GadTxt[copy ],   "COPY",   18,1,White,Blue,Jam1);
  239.   SetIText(GadTxt[copydel], "COPYDEL", 6,1,White,Blue,Jam1);
  240.   SetIText(GadTxt[deldir],  "DELDIR", 10,1,White,Blue,Jam1);
  241.   SetIText(GadTxt[edit ],   "EDIT",   18,1,White,Blue,Jam1);
  242.   SetIText(GadTxt[execfr],  "EXEC f+R",2,1,White,Blue,Jam1);
  243.   SetIText(GadTxt[execrf],  "EXEC R+f",2,1,White,Blue,Jam1);
  244.   SetIText(GadTxt[hprint],  "HPRINT", 10,1,White,Blue,Jam1);
  245.   SetIText(GadTxt[htype],   "HTYPE",  14,1,White,Blue,Jam1);
  246.   SetIText(GadTxt[info],    "INFO",   18,1,White,Blue,Jam1);
  247.   SetIText(GadTxt[makedir], "MAKEDIR", 6,1,White,Blue,Jam1);
  248.   SetIText(GadTxt[move],    "MOVE",   18,1,White,Blue,Jam1);
  249.   SetIText(GadTxt[parent],  "PARENT", 10,1,White,Blue,Jam1);
  250.   SetIText(GadTxt[print],   "PRINT",  14,1,White,Blue,Jam1);
  251.   SetIText(GadTxt[print],   "PRINT",  14,1,White,Blue,Jam1);
  252.   SetIText(GadTxt[rename],  "RENAME", 10,1,White,Blue,Jam1);
  253.   SetIText(GadTxt[root],    "ROOT",   18,1,White,Blue,Jam1);
  254.   SetIText(GadTxt[runfr],   "RUN f+R", 6,1,White,Blue,Jam1);
  255.   SetIText(GadTxt[runrf],   "RUN R+f", 6,1,White,Blue,Jam1);
  256.   SetIText(GadTxt[select],  "SELECT", 10,1,White,Blue,Jam1);
  257.   SetIText(GadTxt[show],    "SHOW",   18,1,White,Blue,Jam1);
  258.   SetIText(GadTxt[type],    "TYPE",   18,1,White,Blue,Jam1);
  259.   SetIText(GadTxt[zapfile], "ZAPFILE", 6,1,White,Blue,Jam1);
  260.   SetIText(GadTxt[dtor],    "D -> R", 10,1,White,Blue,Jam1);
  261.   SetIText(GadTxt[dtos],    "D -> S", 10,1,White,Blue,Jam1);
  262.   SetIText(GadTxt[rtod],    "R -> D", 10,1,White,Blue,Jam1);
  263.   SetIText(GadTxt[rtos],    "R -> S", 10,1,White,Blue,Jam1);
  264.   SetIText(GadTxt[stod],    "S -> D", 10,1,White,Blue,Jam1);
  265.   SetIText(GadTxt[stor],    "S -> R", 10,1,White,Blue,Jam1);
  266.   SetIText(GadTxt[swapsd],  "SWAP S-D",2,1,White,Blue,Jam1);
  267.   SetIText(GadTxt[swaprd],  "SWAP R-D",2,1,White,Blue,Jam1);
  268.   SetIText(GadTxt[swaprs],  "SWAP R-S",2,1,White,Blue,Jam1);
  269.  
  270.   WITH SlideInfo DO             (* Define the slider information *)
  271.     Flags := SliderFlags;
  272.     VertPot := 8000H;
  273.     VertBody := 0FFFFH;
  274.   END;
  275.  
  276.   FOR i := run TO filewindow DO         (* Setup and null all IOStringInfos *)
  277.     IOString[i] := "";
  278.     WITH IOStringInfo[i] DO
  279.       Buffer := ADR(IOString[i]); UndoBuffer := NULL;
  280.       BufferPos := 0; MaxChars := StringBufSize;
  281.       DispPos := 0; NumChars := 0;
  282.     END;
  283.   END;
  284.  
  285. (*  THIS SECTION NOW DEFINES THE GADGETS AND LINKS UP THE STRUCTURES *)
  286.  
  287. (*Device gadgets*)
  288.   j := 6;
  289.   FOR i := df0 TO vd0 DO
  290.     OneGadget(DuGads[i], j, 14, 38, 9,HighComplement,
  291.                 ADR (GadTxt[i]), RegFlags,ADR(Borders[device]),
  292.                 NULL, BoolGadget, i);
  293.     INC(j,41)
  294.   END;
  295.  
  296. (* String gadgets *)
  297.   j := 117;
  298.   FOR i := run TO dest DO
  299.     OneGadget(DuGads[i],    324, j, 280, 10, HighComplement,
  300.                 ADR (GadTxt[i]), RegFlags, ADR(Borders[rsd]),
  301.                 ADR (IOStringInfo[i]), StrGadget, i);
  302.     INC(j,10);
  303.   END;
  304.  
  305.   OneGadget(DuGads[msg],    28, 147, 576, 10, HighComplement,
  306.                 ADR (GadTxt[msg]), RegFlags, ADR(Borders[message]),
  307.                 ADR (IOStringInfo[msg]), StrGadget, msg);
  308.  
  309.   OneGadget(DuGads[filewindow], 5, 24, 281, 121, HighNone,
  310.                 ADR(GadTxt[filewindow]), RegFlags,ADR(Borders[filewind]),
  311.                 NULL,BoolGadget, filewindow);
  312.  
  313. (* Command gadgets *)
  314.   j := 14; k := 308;
  315.   FOR i := arc TO swaprs DO
  316.     OneGadget(DuGads[i], k, j, 68, 9, HighComplement,
  317.                 ADR (GadTxt[i]), RegFlags,ADR(Borders[command]),
  318.                 NULL, BoolGadget, i);
  319.     INC(j,10);
  320.     IF j>104 THEN
  321.       j := 14;
  322.       INC(k,71);
  323.     END;
  324.   END;
  325.  
  326.  
  327. (* Slider gadget *)
  328.  
  329.   OneGadget(DuGads[slider], 289, 23, 18, 122, HighComplement,
  330.                 NULL, RegFlags, ADR(SlideImage),
  331.                 ADR(SlideInfo), PropGadget, slider);
  332.  
  333.  
  334.   FOR i := df0 TO swaprs DO
  335.     m := i; INC(m);
  336.     DuGads[i].NextGadget := ADR(DuGads[m])
  337.   END;
  338.  
  339.   RETURN ADR(DuGads[df0])
  340. END InitGadgets;
  341.  
  342.  
  343. (* ---------------------------*)
  344. (*     EXTERNAL PROCEDURES    *)
  345. (* ---------------------------*)
  346.  
  347.  
  348. PROCEDURE SlidePot():CARDINAL;
  349. (*
  350.   Function returns the current value of the slider VertPot)
  351. *)
  352. BEGIN
  353.   RETURN CARDINAL(SlideInfo.VertPot);
  354. END SlidePot;
  355.  
  356.  
  357. PROCEDURE ResetSlider(bod:CARDINAL);
  358. (*
  359.    Resets slide gadget size to the size passed in
  360. *)
  361. BEGIN
  362.   ModifyProp(DuGads[slider],DuWindowPtr,NullReqPtr^,SliderFlags,0,0,0,bod);
  363. END ResetSlider;
  364.  
  365. (* ---------------------------*)
  366.  
  367. PROCEDURE CloseDuWindow;
  368. (*
  369.   Closes the window and intuition and graphics bases if they are open
  370. *)
  371.  
  372. BEGIN
  373.   IF (DuWindowPtr # NULL) THEN CloseWindow (DuWindowPtr^) END;
  374.   IF IntuitionBase <> 0 THEN CloseLibrary(IntuitionBase) END;
  375.   IF GraphicsBase <> 0  THEN CloseLibrary(GraphicsBase) END;
  376. END CloseDuWindow;
  377.  
  378. (* ---------------------------*)
  379.  
  380. PROCEDURE OpenDuWindow(VAR name:ARRAY OF CHAR):BOOLEAN;
  381.  
  382. (*
  383.         The external primary procedure - sets up and opens the window
  384. *)
  385.  
  386. BEGIN
  387.   IF (GraphicsBase <> 0) AND (IntuitionBase <> 0) THEN
  388.    DuWindowPtr :=  InitWindow(name,InitGadgets());
  389.    RETURN (DuWindowPtr # NULL)
  390.   ELSE
  391.    RETURN FALSE
  392.   END
  393. END OpenDuWindow;
  394.  
  395.  
  396.                 (********)
  397.                 (* MAIN *)
  398.                 (********)
  399.  
  400. BEGIN
  401.   NullReqPtr := NULL;
  402.   IntuitionBase := OpenLibrary (IntuitionName,0);
  403.   GraphicsBase := OpenLibrary (GraphicsName,0);
  404. END DuWindow.
  405.